home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
shazam.exe
/
GUNSORT.IMP
< prev
next >
Wrap
Text File
|
1992-09-01
|
6KB
|
188 lines
{*******************************************************************
GUNSORT.IMP
*******************************************************************}
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
METHODS - UNSORTED STRING COLLECTION
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
FREE ITEM
===================================================================}
procedure TUnsortedCollection.FreeItem ( Item : pointer ) ;
begin
DisposeStr ( Item ) ;
end ;
{===================================================================
PUT ITEM
===================================================================}
procedure TUnsortedCollection.PutItem ( VAR S : TStream ; Item : Pointer ) ;
begin
S.WriteStr ( Item ) ;
end ;
{===================================================================
GET ITEM
===================================================================}
function TUnsortedCollection.GetItem ( VAR S : TStream ) : Pointer ;
begin
GetItem := S.ReadStr ;
end ;
{===================================================================
LOAD
===================================================================}
constructor TUnsortedCollection.Load ( VAR S : TStream ) ;
begin
TCollection.Load ( S ) ;
end ;
{===================================================================
STORE
===================================================================}
procedure TUnsortedCollection.Store ( VAR S : TStream ) ;
begin
TCollection.Store ( S ) ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
EMPTY
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
MENUBAR
===================================================================}
function EmptyMenuBar : PMenuBar ;
var
R : TRect ;
begin
Application^.GetExtent ( R ) ;
R.B.Y := R.A.Y + 1 ;
EmptyMenuBar := New ( PMenuBar , Init ( R , NIL ) ) ;
end ;
{===================================================================
STATUSLINE
===================================================================}
function EmptyStatusLine : PStatusLine ;
var
R : TRect ;
begin
Application^.GetExtent ( R ) ;
R.A.Y := R.B.Y - 1 ;
EmptyStatusLine := New ( PStatusLine , Init ( R , NIL ) ) ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
PSTRING
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
SET - "PString" should always start out NIL.
===================================================================}
procedure SetPStr ( VAR P : PString ; S : string ) ;
begin
if P <> NIL then
begin
DisposeStr ( P ) ;
P := NIL ;
end ;
if S = '' then EXIT ;
P := NewStr ( S ) ;
end ;
{===================================================================
GET
===================================================================}
function GetPStr ( P : PString ) : string ;
begin
if P = NIL then
GetPStr := ''
else
GetPStr := P^ ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
DISPOSE - release memory & set pointer to NIL
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
COLLECTION
===================================================================}
procedure DisposeCollection ( VAR C ) ;
var
PtrRef : PCollection absolute C ;
begin
if PtrRef = NIL then EXIT ;
Dispose ( PtrRef , Done ) ;
PtrRef := NIL ;
end ;
{===================================================================
VIEW
===================================================================}
procedure DisposeView ( VAR P ) ;
var
AView : PView ABSOLUTE P ;
begin
if AView = NIL then EXIT ;
if AView^.Owner <> NIL then
AView^.Owner^.Delete ( AView ) ;
Dispose ( AView , Done ) ;
AView := NIL ;
end ;
{===================================================================
MENUBOX
===================================================================}
procedure DisposeMenuBox ( VAR Box : PMenuBox ) ;
begin
if Box = NIL then EXIT ;
if Box^.Owner <> NIL then
Box^.Owner^.Delete ( Box ) ;
DisposeMenu ( Box^.Menu ) ;
Dispose ( Box , Done ) ;
Box := NIL ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
MENUBOX
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
EXEC - Insert, get command and dispose.
===================================================================}
procedure ExecMenu ( G : PGroup ; Box : PMenuBox ; VAR Event : TEvent ) ;
begin
if Box = NIL then EXIT ;
if Box^.Owner = NIL then
G^.Insert ( Box ) ;
G^.ClearEvent ( Event ) ;
Event.Command := G^.ExecView ( Box ) ;
DisposeMenuBox ( Box ) ;
if Event.Command = 0 then EXIT ;
Event.What := evCommand ;
G^.PutEvent ( Event ) ;
end ;